Belgian Amiga Club - ADF Collection/BS1 part 05.zip/BS1 part 5/IM_Install3.adf/piarc.LZH/vistabin.rexx

OS/2 REXX Batch file | 1992-04-13 | 6KB | 264 lines

/*
 * VISTABIN.rexx  - VISTAPRO (2.0) binary altitude file creation from
 *                  the image processor's main buffer
 *
 *  Written by: Barry Chalmers
 * Last Update: February 16th, 1992
 *         For: Black Belt Systems image processing series IM, IM F/c, and IP.
 * ---------------------------------------------------------------------------
 *    Revision: 1.00
 */

/*
 * open rexxsupport.library -- needed for some functions
 */
if ~show('L',"rexxsupport.library") then do
  if addlib('rexxsupport.library',0,-30,0) then do
      /* everything's ok */
    end;
  else do
    say 'We Have A Library Problem, Unable To Load "rexxsupport.library"';
    say 'Cannot operate script without this library - sorry!';
    exit 10;
    end;
  end;

prtnme = 'IP_Port';
if show('P','IP_Port') = 0 then do
  if show('P','IM_Port') = 0 then do
    say "Can't find image processor's ARexx port!!!";
    say "This script requires IP, IM or IM F/c to run!";
    exit(20);
    end;
  else do
    prtnme = 'IM_Port';
    end;
  end;

cmdpath = 'c:';
if open(fhandle,'rexx:picmdpath','read') then  /* open the file */
  do
    cmdpath = readln(fhandle);
    call close(fhandle);
  end

/*
 * Get the file name parts
 */
  prevpath = 'ram:';
  if show('C',rawpath) = 1 then do
    prevpath = getclip(rawpath);
    end;
  prevname = 'image';
  if show('C',rawname) = 1 then do
    prevname = getclip(rawname);
    end;
  prevext = '.vbn';
  if show('C',rawext) = 1 then do
    prevext = getclip(rawext);
    end;
  rawheight = 2000;
  if show('C',rawalt) = 1 then do
    rawheight = getclip(rawalt);
    end;

address(prtnme);

options results;
'current';
iinfo = result;
options;
parse var iinfo iname ',' inum ',' xw ',' yw ',' s


if xw = 0 then do
  'message "Main image is empty"';
  exit 0;
  end
if yw = 0 then do
  'message "Main image is empty"';
  exit 0;
  end

options results;
'gadgets "Save Vista Binary","Small (258x258)","Large","(514x514)","Huge","(1026x1026)"';
pick = result;
options;

if pick=0 then do
  exit 0;
  end;
if pick=1 then do
  xnew = 258;
  ynew = 258;
  end;
if pick=2 then do
  xnew = 514;
  ynew = 514;
  end;
if pick=3 then do
  xnew = 1026;
  ynew = 1026;
  end;

if xw ~= xnew | yw ~= ynew then do    /* Every language is different */
  if xw > xnew | yw > ynew then do
    stype = 1;
    end;
  if xw <= xnew & yw <= ynew then do
    options results;
    'gadgets "Stretch","to Size","Pad","to Size"';
    stype = result;
    options;
    if stype=0 then do
      exit 0;
      end;
    end;

    options results;
    'askprop "Top Altitude:",'||rawheight||',100,10000';
    rawheight = result;
    options;
    call setclip(rawalt,rawheight);


  if stype = 1 then do
    'entire';
    options results;
    'stretch '||xnew||' '||ynew||' visbin';
    nbuff = result;
    options;
    'newcurrent '||nbuff;
    end;
  if stype = 2 then do
    options results;
    'newasprimary '||xnew||' '||ynew;
    nbuff = result;
    options;
    'newsecondary '||inum;
    'rect 0 0 '||xw||' '||yw;
    'merge'
    end;
  end

  address(prtnme);
  options results;
  'filerequest "'||prevpath||'","'||prevname||'","'||prevext||'","Sv VisBin"';
  binfile = result;
  options;

  call checkfile(binfile);



  address(prtnme);
  options results;
  'jackin';
  jackadr = result;
  options;

  address command cmdpath||'vistabin '||jackadr||' 2 'rawheight||' '||binfile;

  address(prtnme);
  'newcurrent '||inum;
  'killbuff '||nbuff;
  exit 0;
end


checkfile:
arg thefile;
  if thefile = 'FR_CANCELLED' then do
    address(prtnme);
    'tofront';
    exit 0;
    end;
  prevpath = gimmepath(thefile);
  call setclip(rawpath,prevpath);
  prevname = gimmename(thefile);
  call setclip(rawname,prevname);
  prevext  = gimmeext(thefile);
  call setclip(rawext,prevext);
  return;
  end

/*
 * gimmepath
 *
 * This takes the provided argument and sucks the path out of it, then
 * returns that path to the caller, sans file name.
 */
gimmepath:
  arg fullnamegx;
    tempgx = reverse(fullnamegx);
    lengx = length(fullnamegx);   /* get length of string */
    slashdex = index(tempgx,'/'); /* first occurance of '/' from right */
    colondex = index(tempgx,':');  /* first occurance of ':' from right */
    seploc = 0; /* assumes current dir, no path supplied */
    if slashdex ~= 0 then do /* we assume we are in a DIR */
      seploc = (lengx - slashdex)+1;
      end;
    else do
      if colondex ~= 0 then do /* we assume we are on a device */
        seploc = (lengx - colondex)+1;
        end;
      end;
  gxname = substr(fullnamegx,seploc+1); /* if you ever need it */
  gxpath = left(fullnamegx,seploc);
  return(gxpath);
  end


gimmename:
  arg fullnamegx;
    tempgx = reverse(fullnamegx);
    lengx = length(fullnamegx);   /* get length of string */
    slashdex = index(tempgx,'/'); /* first occurance of '/' from right */
    colondex = index(tempgx,':');  /* first occurance of ':' from right */
    seploc = 0; /* assumes current dir, no path supplied */
    if slashdex ~= 0 then do /* we assume we are in a DIR */
      seploc = (lengx - slashdex)+1;
      end;
    else do
      if colondex ~= 0 then do /* we assume we are on a device */
        seploc = (lengx - colondex)+1;
        end;
      end;
  extpos = lastpos(".",fullnamegx) - 2;
  if extpos > seploc then do
    gxname = substr(fullnamegx,seploc+1,extpos-seploc+1);
    end;
  else do
    gxname = substr(fullnamegx,seploc+1);
    end;
  return(gxname);
  end


gimmeext:
  arg fullnamegx;
    tempgx = reverse(fullnamegx);
    lengx = length(fullnamegx);   /* get length of string */
    slashdex = index(tempgx,'/'); /* first occurance of '/' from right */
    colondex = index(tempgx,':');  /* first occurance of ':' from right */
    seploc = 0; /* assumes current dir, no path supplied */
    if slashdex ~= 0 then do /* we assume we are in a DIR */
      seploc = (lengx - slashdex)+1;
      end;
    else do
      if colondex ~= 0 then do /* we assume we are on a device */
        seploc = (lengx - colondex)+1;
        end;
      end;
  extpos = lastpos(fullnamegx,'.');
  if extpos > seploc then do
    gxext = substr(fullnamegx,extpos+1);
    end
  else do
    gxext = '';
    end
  return(gxext);
  end